content: {-# LANGUAGE ConstraintKinds            #-}
  {-# LANGUAGE DeriveGeneric              #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE PackageImports             #-}
  
  module Thentos.CookieSession.Types where
  
  import Control.Lens (Getter)
  import Control.Monad.State.Class (MonadState)
  import "cryptonite" Crypto.Random (MonadRandom, getRandomBytes)
  import Data.Aeson (FromJSON, ToJSON)
  import Data.String.Conversions
  import Data.String (IsString)
  import Data.Typeable (Typeable)
  import GHC.Generics (Generic)
  import Servant.API (FromHttpApiData)
  import qualified Codec.Binary.Base64 as Base64
  import qualified Data.Text as ST
  
  newtype ThentosSessionToken = ThentosSessionToken { fromThentosSessionToken :: ST }
      deriving ( Eq, Ord, Show, Read, Typeable, Generic, IsString
               , FromHttpApiData, FromJSON, ToJSON
               )
  
  class GetThentosSessionToken a where
      getThentosSessionToken :: Getter a (Maybe ThentosSessionToken)
  
  type MonadUseThentosSessionToken s m = (MonadState s m, GetThentosSessionToken s)
  
  -- | Return a base64 encoded random string of length 24 (18 bytes of entropy).
  -- We use @_@ instead of @/@ as last letter of the base64 alphabet since it allows using names
  -- within URLs without percent-encoding. Our Base64 alphabet thus consists of ASCII letters +
  -- digits as well as @+@ and @_@. All of these are reliably recognized in URLs, even if they occur
  -- at the end.
  --
  -- RFC 4648 also has a "URL Safe Alphabet" which additionally replaces @+@ by @-@. But that's
  -- problematic, since @-@ at the end of URLs is not recognized as part of the URL by some programs
  -- such as Thunderbird.
  freshRandomName :: MonadRandom m => m ST
  freshRandomName = ST.replace "/" "_" . cs . Base64.encode <$> getRandomBytes 18
  
  freshSessionToken :: MonadRandom m => m ThentosSessionToken
  freshSessionToken = ThentosSessionToken <$> freshRandomName
  