example TypeFamilies-based roles to mitigate risk of dev backdoors in applications

example-tf-role.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE KindSignatures #-}

-- | Simple type families for limiting things to some given roles.
module TF where

-- | Lookup for a value in a list.
type family Find x ys where
  Find x '[] = 'False
  Find x (x ': ys) = 'True
  Find x (y ': ys) = Find x ys

-- | If a key k evaluates to True, then the value is taken, otherwise we use
-- unit.
type family If k v where
  If 'True v = v
  If 'False v = ()

data Role
  = Dev
  | CI
  | Staging
  | Prod

data Env (r :: Role)
  = Env
    { aside :: If (Find r '[Dev, CI]) DangerousThing
    , app :: Application
    }


type DangerousThing = Int
type Application = String

backdoor :: DangerousThing
backdoor = 42

devEnv :: Env 'Dev
devEnv = Env backdoor "hello"

prodEnv :: Env 'Prod
prodEnv = Env () "hello"

main :: IO ()
main = putStrLn "ok"