f:id:Qsk:20181202164814p:plain

はじめに

この記事は 2018年 Shinjuku.LTアドベントカレンダーの3日目の記事になります！

2日目の記事はこちら qiita.com

4日目の記事はこちら => xxx

Shinjuku.LTってなに？って方はこちら → Shinjuku.LT

やりたかったこと

curl -X GET \
  https://localhost \
  -E crt.pem \
  --key key.pem

的なことをしたかったので調べた。 curlパッケージを使えばできそうだが、手元の環境だとcurlのバージョンが古いみたいでコケた。別のPCで試したら大丈夫だったのでなんでcurlのバージョンが古いままだったのかよくわかってない。

Network.Curl

とりあえず、curl以外の方法を調べていたところ、以下を見つけた。リクエストが出来ることは確認できたが、中身の理解が追いついていなかったので、改めて読んでみる。 stackoverflow.com

内容

以下引用とメモとちょっと調整
- qualified を加えたのと、必要な分だけimportするようにした

{-# LANGUAGE OverloadedStrings #-}
module TLS where

import qualified Data.Default as D (def)
import qualified Network.Connection as NC
import qualified Network.HTTP.Client as NHC (Manager, newManager, defaultManagerSettings)
import qualified Network.HTTP.Client.TLS as NHCT (mkManagerSettings)
import qualified Network.TLS as NT (onCertificateRequest, onServerCertificate, clientHooks, clientSupported, supportedCiphers, credentialLoadX509, defaultParamsClient)
import qualified Network.TLS.Extra.Cipher as NTEC (ciphersuite_strong)
import qualified Servant.Client as SC

makeClientManager :: String -> SC.Scheme -> IO NHC.Manager
makeClientManager hostname SC.Https = mkMngr hostname "crt.pem" "key.pem"
makeClientManager _        SC.Http  = NHC.newManager NHC.defaultManagerSettings

mkMngr :: String -> FilePath -> FilePath -> IO NHC.Manager
mkMngr hostName crtFile keyFile = do
  creds <- either error Just `fmap` NT.credentialLoadX509 crtFile keyFile
  let hooks = D.def
              { NT.onCertificateRequest = \_ -> return creds
              , NT.onServerCertificate = \_ _ _ _ -> return []
              }
      clientParams = (NT.defaultParamsClient hostName  "")
                     { NT.clientHooks = hooks
                     , NT.clientSupported = D.def { NT.supportedCiphers = NTEC.ciphersuite_strong } -- "This ciphersuite list contains RC4. Use ciphersuite_strong or ciphersuite_default instead."
                     }
      tlsSettings = NC.TLSSettings clientParams

  NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing

リクエスト側

import TLS
import Network.HTTP.Client (httpLbs, method, responseTimeout, responseTimeoutMicro, parseRequest)
import Network.HTTP.Types.Method (methodGet)
import qualified Servant.Client as SC

main = do
  manager <- makeClientManager "https://localhost" SC.Https
  initialRequest <- parseRequest "https://localhost"
  let request = initialRequest { method = methodGet, responseTimeout = responseTimeoutMicro 120000000 }
  res <- httpLbs request manager
  putStrLn $ show res

以下やってること整理

makeClientManagerで Network.HTTP.Client の Manager を受ける
1. https だった場合に mkMngr で証明書と鍵をつかった版の Manager を返す
Manager をつかってリクエスト

`mkMngr`でやってることを見ていく

`creds <- either error Just`fmap`NT.credentialLoadX509 crtFile keyFile`

credential作ってるっぽい
either :: (a -> c) -> (b -> c) -> Either a b -> c
- either A B C で Cが Left なら Aを適用、 Right なら B を適用する
- Data.Either

> leftString = Left "LEFT" :: Either String String
> rightString = Right "RIGHT" :: Either String String
> either (++"this is left") (++"this is right") leftString
"LEFTthis is left"
> either (++"this is left") (++"this is right") rightString
"RIGHTthis is right"

error :: [Char] -> a
- errorを返すだけ

> errorTest s = if (length s > 0) then head s else error "ERA====DESU"
> errorTest "aaa"
'a'
> errorTest ""
*** Exception: ERA====DESU
CallStack (from HasCallStack):
  error, called at <interactive>:100:50 in interactive:Ghci22

fmap :: Functor f => (a -> b) -> f a -> f b
- fmap はいいかな
credentialLoadX509
- 証明書を作ってくれる
- credentialLoadX509 :: FilePath -> FilePath -> IO (Either String Credential)

なのでこの行は credentialLoadX509 が IO(Either) を返すので、fmap で Either にして either でエラー出力にするか、Just にするか切り分けてる式ですね。

`let hooks = D.def ...`

let hooks = D.def
            { NT.onCertificateRequest = \_ -> return creds
            , NT.onServerCertificate = \_ _ _ _ -> return []
            }

def
- 初期値を決めてる
- 今回はonCertificateRequest, onServerCertificate を定義してる
- 型は ClientHooks
  - ClientHooks : TLS通信の際に実行される種々のコールバックを設定する
    - onCertificateRequest : サーバーから証明書を要求された時に呼び出される
      - 今回だと \_ -> return creds で証明書をただ返すだけ
    - onServerCertificate : クライアントがサーバー証明書を検証するために使用する
      - return [] で一切検証してないんだけど
        
        参照元に消せって書いてましたね
        
        To answer your question, your code does bypass server certificate validation. Anyone using this code should remove the onServerCertificate line unless they know what they're doing. As it is, this code is dangerous. – mmalone Jan 24 '17 at 1:47

ここは ClientHooks を作る式ですね

`clientParams = (NT.defaultParamsClient hostName "") ...`

clientParams = (NT.defaultParamsClient hostName  "")
               { NT.clientHooks = hooks
               , NT.clientSupported = D.def { NT.supportedCiphers = NTEC.ciphersuite_strong }
               }

NT.defaultParamsClient hostName ""
- ClientParams を返す
- 第二引数のByteStringはサーバーIDを指定するみたい
clientHooks : さっきつくったのをいれる
clientSupported: 暗号のリスト
- D.def { NT.supportedCiphers = NTEC.ciphersuite_strong }
- supportedCiphers
- いちおうざっと中身: Supported {supportedVersions = [TLS12,TLS11,TLS10], supportedCiphers = [ECDHE-ECDSA-AES256GCM-SHA384,ECDHE-ECDSA-AES128GCM-SHA256,ECDHE-RSA-AES256GCM-SHA384,(略)}

ClientParams を作ってて中身はそれぞれのパッケージに定義されているので必要な分だけ入れていけば良いかな

ClientHooks : Network.TLS
ClientParams : Network.TLS

`tlsSettings = NC.TLSSettings clientParams`

tlsSettings = NC.TLSSettings clientParams

TLSSettings ClientParams
ClientParamsを引数にTLSSettings作ってる

data TLSSettings
    = -- (略)
    | TLSSettings TLS.ClientParams -- ClientParamsを渡せばTLSSettingsを得られる
    deriving (Show)

`NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing`

NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing

NHCT.mkManagerSettings tlsSettings Nothingで得たManagerSettingsをnewManagerで使うだけ

使う側

manager <- makeClientManager "https://localhost" SC.Https
initialRequest <- parseRequest "https://localhost"
let request = initialRequest { method = methodGet, responseTimeout = responseTimeoutMicro 120000000 }
res <- httpLbs request manager

おわり

貼り付けたら動いたからまあ一旦良いや、で終わらしていたのを改めて読み直してみました。 \_ _ _ _ -> return [] とか書かれてたら面食らって理解を諦めるけど、時間をかければ意外と理解はできた。そもそもTLSの仕様的な理解が足りてないのでClientHooks周りはわかったの？と問われればアレ。 def の使い方がまだぼやっとしてるのでData.Default はまた別途みなおすかも。最終的にはほしい動きを自分でかけるようになりたいですね。以上、3日目でした。

Shinjuku.LT Advent Calendar 2018 まだまだ続きます!!

2日目の記事はこちら qiita.com

4日目の記事はこちら => xxx

Home Dog Heavy

haskellでクライアント証明書を利用したリクエスト

はじめに

やりたかったこと

内容

以下やってること整理

`mkMngr`でやってることを見ていく

`creds <- either error Just`fmap`NT.credentialLoadX509 crtFile keyFile`

`let hooks = D.def ...`

`clientParams = (NT.defaultParamsClient hostName "") ...`

`tlsSettings = NC.TLSSettings clientParams`

`NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing`

使う側

おわり

Shinjuku.LT Advent Calendar 2018 まだまだ続きます!!

はじめに

やりたかったこと

内容

以下やってること整理

mkMngrでやってることを見ていく

creds <- either error JustfmapNT.credentialLoadX509 crtFile keyFile

let hooks = D.def ...

clientParams = (NT.defaultParamsClient hostName "") ...

tlsSettings = NC.TLSSettings clientParams

NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing

使う側

おわり

Shinjuku.LT Advent Calendar 2018 まだまだ続きます!!

`mkMngr`でやってることを見ていく

`creds <- either error Just`fmap`NT.credentialLoadX509 crtFile keyFile`

`let hooks = D.def ...`

`clientParams = (NT.defaultParamsClient hostName "") ...`

`tlsSettings = NC.TLSSettings clientParams`

`NHC.newManager $ NHCT.mkManagerSettings tlsSettings Nothing`