1 files changed, 92 insertions(+), 0 deletions(-)

A scripts/haskell/cookies.sh

@@ 0,0 1,92 @@
+#!/usr/bin/env cabal
+
+{- cabal:
+  default-language: GHC2021
+  default-extensions:
+    LambdaCase
+    OverloadedStrings
+  build-depends:
+      base
+    , relude
+    , transformers
+  mixins:
+      base hiding (Prelude)
+    , relude (Relude as Prelude)
+    , relude
+-}
+
+import Control.Monad (liftM)
+import Control.Monad.Trans.State.Strict (mapStateT)
+
+main :: IO ()
+main = entrypoint
+
+--
+-- Core privacy module.
+
+data Decision = Accepted | Rejected deriving (Show, Eq)
+data Consent = Decided Decision | Pending deriving (Show, Eq)
+data Purpose = Essential | Inessential deriving (Show, Eq)
+
+-- Using a `StateT` to demonstrate, but any transformer will do.
+-- The notion of `CookieSetterT` could be folded into a more general `AppM`.
+-- This is appealing thinking for example of how widespread our usage of
+-- `Locale.Reader` is, and that it could centralise most React contexts into
+-- one context and one data structure.
+type CookieSetterT = StateT Consent
+type CookieSetter = CookieSetterT Identity
+
+allowed :: Purpose -> CookieSetter Bool
+allowed p = get <&> \c -> case (p, c) of
+  (Essential, _)        -> True
+  (_, Decided Accepted) -> True
+  _                     -> False
+
+givenConsent :: Monad m => Purpose -> m () -> CookieSetterT m ()
+givenConsent p m = whenM (generalise (allowed p)) (lift m)
+  where generalise = mapStateT (pure . runIdentity)
+
+--
+-- Data storage module.
+
+-- We can comfortably gate our action requiring consent behind `givenConsent`.
+-- This should be the only way to construct a `CookieSetterT`. In turn a cookie
+-- module would be the only way to interact with `document.cookie`.
+setCookie :: Purpose -> Text -> Text -> CookieSetterT IO ()
+setCookie p k v = givenConsent p $ putTextLn ("Setting cookie: " <> k <> ":" <> v <> ".")
+
+setLocalStorage :: Purpose -> Text -> a -> CookieSetterT IO ()
+setLocalStorage p k v = givenConsent p $ pure ()
+
+-- Any monad is supported e.g. `Task` provided we can map it to our most
+-- powerful entrypoint monad (e.g. `Task.fromIO`).
+setSomethingElse :: Monad m => Purpose -> Text -> a -> CookieSetterT m ()
+setSomethingElse p k v = givenConsent p $ pure ()
+
+--
+-- Call site module.
+
+setTrackingCookie :: CookieSetterT IO ()
+setTrackingCookie = setCookie Inessential "tracking-key" "tracking-val"
+
+entrypoint :: IO ()
+entrypoint = void $ flip runStateT Pending $ do
+  putTextLn "Initialise and start trying to get consent."
+
+  setConsent Pending
+  trySetTrackingCookie
+
+  setConsent (Decided Rejected)
+  trySetTrackingCookie
+
+  setConsent (Decided Accepted)
+  trySetTrackingCookie
+
+  putTextLn "\nRender JSX or something."
+
+  where setConsent x = do
+          putTextLn $ "\nUser set consent: " <> show x <> "."
+          put x
+        trySetTrackingCookie = do
+          putTextLn $ "\nRequested setting tracking cookie."
+          setTrackingCookie